home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qbsnip.zip / TREE.BAS < prev    next >
BASIC Source File  |  1997-05-04  |  4KB  |  157 lines
  1. ' TREE.BAS
  2. ' by Mike Ginger
  3. '
  4. ' public domain
  5. ' No warranties or guarantees are expressed or implied.
  6. '
  7. ' Purpose: Displays files in a dir with information about each file.
  8.  
  9. '$INCLUDE: 'QB.BI'
  10. DEFINT A-Z
  11. DECLARE FUNCTION CountFiles (Srch$)
  12. DECLARE FUNCTION FInfoDate$ (FDate)
  13. DECLARE FUNCTION FInfoTime$ (FTime)
  14. DECLARE SUB LoadFileInfo (F() AS ANY, N%, Srch$)
  15.  
  16. TYPE FileInfo
  17. FileName    AS STRING * 12
  18. Size        AS LONG
  19. FDate       AS INTEGER
  20. FTime       AS INTEGER
  21. END TYPE
  22.  
  23. TYPE DTAType
  24. Drive       AS STRING * 1
  25. Template    AS STRING * 11
  26. Attr        AS STRING * 1
  27. DirEntry    AS INTEGER
  28. DTAPtr      AS LONG
  29. Cluster     AS INTEGER
  30. FileAttb    AS STRING * 1
  31. FileTime    AS INTEGER
  32. FileDate    AS INTEGER
  33. FileSize    AS LONG
  34. FileName    AS STRING * 13
  35. END TYPE
  36.  
  37. CLS
  38.  
  39.  N = CountFiles("*.*")
  40.     IF N = 0 THEN
  41.      PRINT "No files found"
  42.     END
  43.     END IF
  44.  
  45. REDIM F(1 TO N) AS FileInfo
  46. CALL LoadFileInfo(F(), N, "*.*")
  47. FOR i = 1 TO N
  48. PRINT F(i).FileName; TAB(14);
  49. PRINT USING "##########"; F(i).Size;
  50. PRINT TAB(25); FInfoDate$(F(i).FDate);
  51. PRINT TAB(36); FInfoTime$(F(i).FTime)
  52. mike% = mike% + 1
  53.  IF mike% = 15 THEN
  54.     mike% = 0
  55.     INPUT "Press RETURN to continue"; pause$
  56.  END IF
  57. NEXT
  58.  
  59. FUNCTION CountFiles (Srch$)
  60. DIM DTA AS DTAType
  61. DIM FileName AS STRING * 65
  62. DIM InRegs AS RegTypeX
  63. DIM OutRegs AS RegTypeX
  64.  
  65. InRegs.ax = &H2F00
  66. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  67. OldDTASeg = OutRegs.es
  68. OldDTAAdd = OutRegs.bx
  69.  
  70. InRegs.ax = &H1A00
  71. InRegs.ds = VARSEG(DTA)
  72. InRegs.dx = VARPTR(DTA)
  73. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  74.  
  75. N = 0
  76. FileName = Srch$ + CHR$(0)
  77. InRegs.ds = VARSEG(FileName)
  78. InRegs.dx = VARPTR(FileName)
  79. InRegs.ax = &H4E00
  80. DO
  81. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  82. InRegs.ax = &H4F00
  83. IF (OutRegs.flags AND 1) = 0 THEN
  84. N = N + 1
  85. ELSE
  86. IF N = 0 THEN PRINT "Error -> "; OutRegs.ax
  87. EXIT DO
  88. END IF
  89. LOOP
  90. InRegs.ax = &H1A00
  91. InRegs.ds = OldDTASeg
  92. InRegs.dx = OldDTAAdd
  93. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  94. CountFiles = N
  95. END FUNCTION
  96.  
  97. FUNCTION FInfoDate$ (Num)
  98. M = (Num AND 480) \ 32
  99. D = Num AND 31
  100. Y = 1980 + (Num AND 65024) \ 512
  101. M$ = LTRIM$(STR$(M)): DO WHILE LEN(M$) < 2: M$ = "0" + M$: LOOP
  102. D$ = LTRIM$(STR$(D)): DO WHILE LEN(D$) < 2: D$ = "0" + D$: LOOP
  103. Y$ = LTRIM$(STR$(Y)): DO WHILE LEN(Y$) < 4: Y$ = "0" + Y$: LOOP
  104. FInfoDate$ = M$ + "/" + D$ + "/" + Y$
  105. END FUNCTION
  106.  
  107. FUNCTION FInfoTime$ (Num)
  108. H = (Num AND 63488) \ 2048
  109. M = (Num AND 2016) \ 32
  110. S = (Num AND 31) * 2
  111. H$ = LTRIM$(STR$(H)): DO WHILE LEN(H$) < 2: H$ = "0" + H$: LOOP
  112. M$ = LTRIM$(STR$(M)): DO WHILE LEN(M$) < 2: M$ = "0" + M$: LOOP
  113. S$ = LTRIM$(STR$(S)): DO WHILE LEN(S$) < 2: S$ = "0" + S$: LOOP
  114. FInfoTime$ = H$ + ":" + M$ + ":" + S$
  115. END FUNCTION
  116.  
  117. SUB LoadFileInfo (F() AS FileInfo, N, Srch$)
  118. DIM FileName AS STRING * 65
  119. DIM DTA AS DTAType
  120. DIM InRegs AS RegTypeX
  121. DIM OutRegs AS RegTypeX
  122.  
  123. InRegs.ax = &H2F00
  124. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  125. OldDTASeg = OutRegs.es
  126. OldDTAAdd = OutRegs.bx
  127.  
  128. InRegs.ax = &H1A00
  129. InRegs.ds = VARSEG(DTA)
  130. InRegs.dx = VARPTR(DTA)
  131. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  132.  
  133. N = 0
  134. FileName = Srch$ + CHR$(0)
  135. InRegs.ds = VARSEG(FileName)
  136. InRegs.dx = VARPTR(FileName)
  137. InRegs.ax = &H4E00
  138. DO
  139. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  140. InRegs.ax = &H4F00
  141. IF (OutRegs.flags AND 1) = 0 THEN
  142. N = N + 1
  143. F(N).FileName = LEFT$(DTA.FileName, INSTR(DTA.FileName, CHR$(0)) - 1)
  144. F(N).FDate = DTA.FileDate
  145. F(N).FTime = DTA.FileTime
  146. F(N).Size = DTA.FileSize
  147. ELSE
  148. EXIT DO
  149. END IF
  150. LOOP
  151. InRegs.ax = &H1A00
  152. InRegs.ds = OldDTASeg
  153. InRegs.dx = OldDTAAdd
  154. CALL INTERRUPTX(&H21, InRegs, OutRegs)
  155. END SUB
  156.  
  157.